home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / codegen / backpatch.sml next >
Encoding:
Text File  |  1993-01-27  |  3.4 KB  |  103 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2. signature BACKPATCH =
  3. sig
  4.     eqtype Label
  5.     val newlabel : unit -> Label
  6.     type JumpKind
  7.     val emitstring : string -> unit
  8.     val align : unit -> unit
  9.     val define : Label -> unit
  10.     val jump : JumpKind*Label -> unit
  11.     val mark : unit -> unit
  12.     val finish : unit -> string
  13. end
  14.  
  15. signature JUMPS =
  16. sig
  17.   type JumpKind
  18.   val sizejump : JumpKind*int*int*int -> int
  19.   val emitjump : JumpKind*int*int*int -> string
  20.   val emitlong : int -> string
  21. end
  22.  
  23. functor Backpatch(Kind: JUMPS) : BACKPATCH =
  24. struct 
  25.   open Kind System.Tags
  26.   type Label = int ref
  27.   fun newlabel() = ref 0
  28.  
  29.   datatype Desc
  30.      = BYTES of string * Desc | JUMP of JumpKind * Label * int ref * Desc
  31.      | LABEL of Label * Desc | ALIGN of Desc | MARK of Desc | NIL
  32.  
  33.   fun compress(len, sl as [s], r0 as BYTES(t,r)) =
  34.              let val lent = size t
  35.               in if len+len > lent andalso lent < 500 andalso len<500
  36.                    then compress(len+lent, t::sl, r)
  37.            else BYTES(s, r0)
  38.              end
  39.     | compress(len, sl, r0 as BYTES(t,r)) =
  40.              let val lent = size t
  41.               in if len+len > lent andalso lent < 500
  42.                    then compress(len+lent, t::sl, r)
  43.            else BYTES(implode sl, r0)
  44.              end
  45.     | compress(len, sl, r0) = BYTES(implode sl, r0)
  46.  
  47.   val refs = ref NIL
  48.   fun emitstring s = refs := compress(size s, [s],!refs)
  49.   fun align() = refs := ALIGN(!refs)
  50.   fun mark() = refs := MARK(!refs)
  51.   fun define lab = refs := LABEL(lab, !refs)
  52.   fun jump(k,lab) = refs := JUMP(k,lab,ref 0, !refs)
  53.  
  54.   fun reverse(r,NIL) = r
  55.     | reverse(r,BYTES(s,q)) = reverse(BYTES(s,r),q)
  56.     | reverse(r,ALIGN q) = reverse(ALIGN r, q)
  57.     | reverse(r,MARK q) = reverse(MARK r, q)
  58.     | reverse(r,LABEL(lab,q)) = reverse(LABEL(lab,r), q)
  59.     | reverse(r,JUMP(k,lab,x,q)) = reverse(JUMP(k,lab,x,r),q)
  60.  
  61.   fun finish() =
  62.    let val changed = ref true
  63.  
  64.        fun labels (pos, BYTES(s,rest)) = labels(pos+size s,rest)
  65.          | labels (pos, JUMP(k,l,ref size, rest)) = labels(pos+size, rest)
  66.      | labels (pos, LABEL(l,rest)) = (l := pos; labels(pos,rest))
  67.      | labels (pos, lab as ALIGN rest) = labels(((pos+3)div 4)*4, rest)
  68.      | labels (pos, MARK rest) = labels(pos+4, rest)
  69.      | labels (pos, NIL) = ()
  70.  
  71.        fun adjust (pos, BYTES(s,rest)) = adjust(pos+size s,rest)
  72.      | adjust (pos, JUMP(k, l, r as ref size, rest)) =
  73.         let val s = sizejump(k, size, pos, !l)
  74.             in  if s > size then (r := s; changed := true) else ();
  75.                     adjust(pos+size, rest)
  76.         end
  77.      | adjust (pos, LABEL(l,rest)) = adjust(pos,rest)
  78.      | adjust (pos, ALIGN rest) = adjust(((pos+3)div 4)*4, rest)
  79.      | adjust (pos, MARK rest) = adjust(pos+4, rest)
  80.      | adjust (pos, NIL) = ()
  81.  
  82.        fun chunk(pos, BYTES(s,r)) = s :: chunk(pos+size s,r)
  83.      | chunk(pos, JUMP(k,l,ref size, r)) =
  84.             emitjump(k,size,pos,!l) :: chunk(pos+size,r)
  85.      | chunk(pos, LABEL(l, rest)) = chunk(pos,rest)
  86.      | chunk(pos, ALIGN rest) =
  87.         (case pos mod 4
  88.           of 0 => chunk(pos,rest)
  89.            | 1 => "\000\000\000" :: chunk(pos+3,rest)
  90.            | 2 => "\000\000" :: chunk(pos+2,rest)
  91.            | 3 => "\000" :: chunk(pos+1,rest))
  92.      | chunk(pos, MARK r) =
  93.                 emitlong(make_desc((pos+4)div 4,tag_backptr)) 
  94.         :: chunk(pos+4, r)
  95.      | chunk(pos, NIL) = nil
  96.  
  97.        val reflist = reverse (ALIGN NIL, !refs) before refs := NIL
  98.     in  while !changed
  99.        do (changed := false; labels(0, reflist); adjust(0, reflist));
  100.     implode(chunk(0, reflist))
  101.    end
  102. end (* functor BackPatch *)
  103.